prep

load packages

library(tidyverse)
library(lme4)
library(lmerTest)
library(knitr)
library(cowplot)
library(caret)
library(ROCR)

define aesthetics

algorithm = c("#006989", "#FEC601", "#F43C13", "#00A5CF", "#00A878")
instruction = wesanderson::wes_palette("Darjeeling1", 2, "continuous")
craving = wesanderson::wes_palette("Darjeeling1", 3, "continuous")
rating = c("#00A08A", "#F2AD00", "#F98400", "#FF0000")
palette_condition = c("#685369", "#EEAC00", "#C1C3DE")
dc_bw = plot_aes = theme_minimal() +
  theme(legend.position = "top",
        legend.text = element_text(size = 12),
        text = element_text(size = 16, family = "Futura Medium"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.text = element_text(color = "black"),
        axis.line = element_line(colour = "black"),
        axis.ticks.y = element_blank())

define functions

table_model = function(model_data) {
  model_data %>%
    broom.mixed::tidy(., conf.int = TRUE) %>%
    rename("SE" = std.error,
           "t" = statistic,
           "p" = p.value) %>%
    filter(effect == "fixed") %>%
    select(-group, -effect) %>%
    mutate_at(vars(-contains("term"), -contains("value")), round, 2) %>%
    mutate(term = gsub(":", " x ", term),
           term = gsub("dot_", "", term),
           term = gsub("wave2", " wave (post)", term),
           term = gsub("instructionregulate", "instruction (regulate)", term),
           term = gsub("conditionCognitive", "condition (cognitive)", term),
           term = gsub("conditionReappraisal", "condition (reappraisal)", term),
           term = gsub("conditionBehavioral", "condition (behavioral)", term),
           term = gsub("conditionControl", "condition (control)", term),
           p = ifelse(p < .001, "< .001",
                      ifelse(p == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
           `b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
    select(term, `b [95% CI]`, df, t, p) %>%
    kable()
}

load tidied data

source("load_data.R")

check ratings

Check if wrong buttons were used (i.e., not 5-8)

  • DEV001 = code normally
  • DEV011 = code normally
  • DEV016 = code normally
  • DEV017 = exclude; can’t tell if they’re missed ratings or incorrect placement of fingers
  • DEV019 = exclude; can’t tell if they’re missed ratings or incorrect placement of fingers
  • DEV020 = code normally
  • DEV022 = code normally
  • DEV028 = code normally
  • DEV032 = incorrect placement of fingers; recode runs 1-2 (LOOK INTO WTP)
  • DEV037 = exclude; technical error?
  • DEV054 = exclude; technical error?
  • DEV060 = code normally; task ended early
  • DEV061 = code normally; task ended early
  • DEV063 = code normally; task ended early
  • DEV069 = incorrect placement of fingers in run1
  • DEV075 = code normally
  • DEV082 = code normally
  • DEV083 = code normally

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

subs = data.all %>%
  group_by(subjectID, wave, run, rating) %>%
  summarize(n = n()) %>%
  spread(rating, n) %>%
  mutate(messed = ifelse(is.na(`5`) & !is.na(`<NA>`), "yes", NA)) %>%
  filter(messed == "yes") %>% 
  ungroup() %>% 
  select(subjectID, wave) %>% 
  unique()

data.all %>%
  group_by(subjectID, run, rating) %>%
  summarize(n = n()) %>%
  spread(rating, n) %>%
  mutate(messed = ifelse(is.na(`5`) & !is.na(`<NA>`), "yes", NA)) %>%
  filter(subjectID %in% subs$subjectID)

recode and exclude

Recoding
* DEV069: recode runs1

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

data.ex = data.all %>%
  mutate(rating = ifelse(subjectID == "DEV069" & run == "run1", rating - 1, rating),
         rating = ifelse(subjectID == "DEV069" & run == "run1" & is.na(rating), 8, rating),
         rating = rating - 4) %>%
  group_by(subjectID, wave) %>%
  arrange(subjectID, run) %>%
  mutate(trial = row_number())

load mean intensity values

file_dir = "dotProducts_ROC_wave1/"
file_pattern =  "DEV[0-9]{3}_meanIntensity.txt"
file_list = list.files(file_dir, pattern =  file_pattern)


intensities = data.frame()

for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "meanIntensity" = V3) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    mutate(beta = as.integer(beta),
                           wave = 1), error = function(e) message(file))
  intensities = rbind(intensities, temp)
  rm(temp)
}

file_dir = "dotProducts_ROC_wave2/"
file_list = list.files(file_dir, pattern =  file_pattern)
for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "meanIntensity" = V3) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    mutate(beta = as.integer(beta),
                           wave = 2), error = function(e) message(file))
  intensities = rbind(intensities, temp)
  rm(temp)
}

load dot products

file_dir = "dotProducts_ROC_wave1/"
file_pattern =  "DEV[0-9]{3}_dotProducts.txt"
file_list = list.files(file_dir, pattern =  file_pattern)

dots = data.frame()

for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "map" = V3,
                           "dotProduct" = V4) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    extract(map, "algorithm", "(.*)_.*.nii") %>%
                    mutate(beta = as.integer(beta),
                            wave = 1), error = function(e) message(file))
  dots = rbind(dots, temp)
  rm(temp)
}

file_dir = "dotProducts_ROC_wave2/"
file_list = list.files(file_dir, pattern =  file_pattern)

for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "map" = V3,
                           "dotProduct" = V4) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    extract(map, "algorithm", "(.*)_.*.nii") %>%
                    mutate(beta = as.integer(beta),
                            wave = 2), error = function(e) message(file))
  dots = rbind(dots, temp)
  rm(temp)
}

join intensities and dots

  • recode trials with extreme intensities as NA
dots.merged = dots %>%
  left_join(., intensities, by = c("subjectID", "wave", "beta")) %>%
  group_by(subjectID, wave, algorithm) %>%
  mutate(rownum = row_number())

# plot original
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  ggplot(aes(1, meanIntensity)) +
    geom_boxplot()

# assess extreme values and exclude when calculating SDs
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  arrange(meanIntensity)
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  arrange(-meanIntensity)
# recode outliers as NA
dots.merged = dots.merged %>%
  ungroup() %>%
  mutate(meanIntensity = ifelse(meanIntensity > 1 | meanIntensity < -1, NA, meanIntensity),
         median = median(meanIntensity, na.rm = TRUE),
         sd3 = 3*sd(meanIntensity, na.rm = TRUE),
         outlier = ifelse(meanIntensity > median + sd3 | meanIntensity < median - sd3, "yes", "no"),
         dotProduct = ifelse(outlier == "yes", NA, dotProduct))
  
# plot after
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  ggplot(aes(1, meanIntensity)) +
    geom_boxplot()

recode subs

  • DEV022 = run4 has 8 trials
  • DEV037 = ???
  • DEV048 = run4 missing
  • DEV060 = run1 has 19 trials; couldn’t estimate run1 trial 19, run3 trial 20
  • DEV061 = run3 has 19 trials; couldn’t estimate run3 trial 19
  • DEV063 = run2 has 11 trials
  • DEV081 = run2 missing (run1 was run twice)
  • DEV082 = run2 has 15 trials; couldn’t estimate run1 trial 19, run1 trial 20

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

trial.numbers = data.frame(subjectID = c(rep("DEV060", 79), rep("DEV061", 79), rep("DEV063", 71), rep("DEV081", 80), rep("DEV082", 75)),
                           wave = 1,
                           rownum = c(1:79, 1:79, 1:71, 1:80, 1:75),
                           trial = c(1:19, 21:80, 1:59, 61:80, 1:31, 41:80, 1:20, 41:80, 21:40, 1:35, 41:80))

dots.check = dots.merged %>%
  group_by(subjectID, wave, algorithm) %>%
  mutate(rownum = row_number()) %>%
  left_join(., trial.numbers, by = c("subjectID", "wave", "rownum")) %>%
  mutate(trial = ifelse(is.na(trial), rownum, trial),
         dotProduct = ifelse(subjectID == "DEV060" & wave == 1 & trial %in% 19:20, NA,
                      ifelse(subjectID == "DEV061" & wave == 1 & trial == 59, NA,
                      ifelse(subjectID == "DEV082" & wave == 1 & trial %in% 19:20, NA, dotProduct)))) %>%
  select(-rownum) #%>%
  #left_join(., striping, by = c("subjectID", "beta")) %>%
  #mutate(dotProduct = ifelse(!is.na(striping), NA, dotProduct))

merge data and exclude subs

Exclusions

  • MRI motion and data quality exclusions: DEV001, DEV020, DEV032, DEV047, DEV055, DEV064, DEV066
  • Button box exclusions: DEV017, DEV019, DEV037, DEV054
  • Run exclusions: DEV029 (run3), DEV037 (run1), DEV042 (run4), DEV067 (run4)

Other
* select only craved trials

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

conditions = read.csv("~/Desktop/dev_conditions.csv")

data_all = left_join(dots.check, data.ex, by = c("subjectID", "wave", "trial")) %>%
  filter(!(subjectID %in% c("DEV001","DEV020","DEV032","DEV047","DEV055","DEV064","DEV066", "DEV017", "DEV019", "DEV037", "DEV054") & wave == 1)) %>%
  filter(!(subjectID == "DEV029" & wave == 1 & run == "run3") & !(subjectID == "DEV037" & wave == 1 & run == "run1") & !(subjectID == "DEV042" & wave == 1 & run == "run4") & !(subjectID == "DEV067" & wave == 1 & run == "run4")) %>%
  ungroup() %>%
  mutate(algorithm = gsub("_signature", "", algorithm),
         wave = as.character(wave)) %>%
  select(-condition) %>%
  left_join(., conditions) %>%
  filter(condition %in% c("Cognitive", "Control")) %>%
  mutate(condition = recode(condition, "Cognitive" = "Reappraisal"),
         wave = as.numeric(recode(wave, "1" = "0", "2" = "1")))

data = data_all %>%
  filter(craving == "craved") %>%
  filter(algorithm == "craving_regulation")

summarize

n participants by wave

data %>%
  select(subjectID, wave) %>%
  unique() %>%
  group_by(wave) %>%
  summarize(n = n())

n trials

data %>%
  filter(algorithm == "craving_regulation") %>%
  group_by(subjectID) %>%
  summarize(n = n()) %>%
  arrange(n)

roc

by wave

# roc curve
perf.df = data %>%
  filter(algorithm == "craving_regulation") %>%
  filter(!is.na(dotProduct) & !is.na(craving)) %>%
  mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
  group_by(wave) %>%
  do({
    wave = .$wave
    pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
    perf = performance(pred, measure = "tpr", x.measure = "fpr")
    data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
  })

ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
  geom_line() +
  scale_color_manual(values = algorithm) +
  xlab("false positive rate") +
  ylab("true positive rate")

roc = data %>%
  filter(algorithm == "craving_regulation") %>%
  select(subjectID, trial, instruction, rating, dotProduct) %>%
  mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
         guess.rating = ifelse(dotProduct > 0, "low", "high"),
         rating.bin = ifelse(rating >= 3, "high", "low"),
         instruction = as.factor(instruction),
         guess.instruction = as.factor(guess.instruction),
         rating.bin = as.factor(rating.bin),
         guess.rating = as.factor(guess.rating))

confusionMatrix(roc$guess.instruction, roc$instruction)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction look regulate
##   look     3495     1318
##   regulate 2344     4508
##                                                
##                Accuracy : 0.6861               
##                  95% CI : (0.6776, 0.6945)     
##     No Information Rate : 0.5006               
##     P-Value [Acc > NIR] : < 0.00000000000000022
##                                                
##                   Kappa : 0.3723               
##                                                
##  Mcnemar's Test P-Value : < 0.00000000000000022
##                                                
##             Sensitivity : 0.5986               
##             Specificity : 0.7738               
##          Pos Pred Value : 0.7262               
##          Neg Pred Value : 0.6579               
##              Prevalence : 0.5006               
##          Detection Rate : 0.2996               
##    Detection Prevalence : 0.4126               
##       Balanced Accuracy : 0.6862               
##                                                
##        'Positive' Class : look                 
## 
#confusionMatrix(roc$guess.rating, roc$rating.bin)

by condition

# roc curve
perf.df = data %>%
  filter(algorithm == "craving_regulation") %>%
  filter(!is.na(dotProduct) & !is.na(craving)) %>%
  mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
  group_by(condition, wave) %>%
  do({
    condition = .$condition
    wave = .$wave
    pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
    perf = performance(pred, measure = "tpr", x.measure = "fpr")
    data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
  })

ggplot(perf.df, aes(fpr, tpr, color = condition, linetype = as.factor(wave))) +
  geom_line() +
  scale_color_manual(values = algorithm) +
  xlab("false positive rate") +
  ylab("true positive rate")

roc = data %>%
  filter(algorithm == "craving_regulation") %>%
  select(subjectID, condition, trial, instruction, rating, dotProduct) %>%
  mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
         guess.rating = ifelse(dotProduct > 0, "low", "high"),
         rating.bin = ifelse(rating >= 3, "high", "low"),
         instruction = as.factor(instruction),
         guess.instruction = as.factor(guess.instruction),
         rating.bin = as.factor(rating.bin),
         guess.rating = as.factor(guess.rating))

confusionMatrix(filter(roc, condition == "Cognitive")$guess.instruction, filter(roc, condition == "Cognitive")$instruction)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction look regulate
##   look        0        0
##   regulate    0        0
##                                   
##                Accuracy : NaN     
##                  95% CI : (NA, NA)
##     No Information Rate : NA      
##     P-Value [Acc > NIR] : NA      
##                                   
##                   Kappa : NaN     
##                                   
##  Mcnemar's Test P-Value : NA      
##                                   
##             Sensitivity :  NA     
##             Specificity :  NA     
##          Pos Pred Value :  NA     
##          Neg Pred Value :  NA     
##              Prevalence : NaN     
##          Detection Rate : NaN     
##    Detection Prevalence : NaN     
##       Balanced Accuracy :  NA     
##                                   
##        'Positive' Class : look    
## 
#confusionMatrix(roc$guess.rating, roc$rating.bin)

MLM

Disaggregate within and between person relationships

  • dot_between = grand mean centered person average signature expression
  • dot_within = person-centered signature expression
between = data %>%
  group_by(condition, wave, subjectID, algorithm) %>%
  summarize(dot_between = mean(dotProduct, na.rm = TRUE)) %>%
  ungroup() %>%
  mutate(dot_between = scale(dot_between, center = TRUE, scale = TRUE))

data_diss = data %>%
  group_by(wave, subjectID, algorithm) %>%
  mutate(dot_within = scale(dotProduct, center = TRUE, scale = TRUE)) %>%
  left_join(., between) %>%
  select(subjectID, condition, wave, trial, instruction, rating, dotProduct, dot_within, dot_between)

no brain

craving ~ wave x instruction

the intervention decreased cravings; this effect is slightly weaker when regulating

tidytable

mod_insruction = lmer(rating ~ instruction * wave * condition + (1 + instruction * wave | subjectID),
                  data = data_diss,
                  control = lmerControl(optimizer = "bobyqa"))
table_model(mod_insruction)
term b [95% CI] df t p
(Intercept) 3.28 [3.17, 3.39] 160.97 59.29 < .001
instruction (regulate) -0.99 [-1.11, -0.86] 160.12 -15.58 < .001
wave -0.40 [-0.54, -0.25] 132.78 -5.42 < .001
condition (reappraisal) 0.02 [-0.13, 0.17] 160.96 0.27 .790
instruction (regulate) x wave 0.08 [-0.06, 0.21] 137.67 1.13 .260
instruction (regulate) x condition (reappraisal) 0.00 [-0.17, 0.18] 159.65 0.03 .980
wave x condition (reappraisal) -0.30 [-0.50, -0.09] 131.48 -2.91 < .001
instruction (regulate) x wave x condition (reappraisal) 0.00 [-0.18, 0.19] 135.81 0.05 .960

plot

look and regulate

ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(facet == "Control") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  facet_grid(~group) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(1.5, 3.5)) +
  labs(x = "", y = "predicted craving rating\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  facet_grid(~group) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(1.5, 3.5)) +
  labs(x = "", y = "predicted craving rating\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

#ggsave(p, filename = "~/Desktop/craving.png", width = 5, height = 4, bg = "white")

regulate only

ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(facet == "Control") %>%
  filter(group == "regulate") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(1.5, 2.5)) +
  labs(x = "", y = "predicted craving rating\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(group == "regulate") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(1.5, 2.5)) +
  labs(x = "", y = "predicted craving rating\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

#ggsave(p, filename = "~/Desktop/craving.png", width = 5, height = 4, bg = "white")

model summary

summary(mod_insruction)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ instruction * wave * condition + (1 + instruction *  
##     wave | subjectID)
##    Data: data_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 24381.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.8850 -0.6725  0.0340  0.6616  4.0455 
## 
## Random effects:
##  Groups    Name                     Variance Std.Dev. Corr             
##  subjectID (Intercept)              0.2087   0.4568                    
##            instructionregulate      0.2588   0.5088   -0.44            
##            wave                     0.2872   0.5359   -0.13 -0.09      
##            instructionregulate:wave 0.1844   0.4294   -0.07 -0.26 -0.58
##  Residual                           0.4554   0.6749                    
## Number of obs: 11239, groups:  subjectID, 172
## 
## Fixed effects:
##                                                 Estimate Std. Error         df
## (Intercept)                                     3.275897   0.055251 160.973208
## instructionregulate                            -0.987416   0.063371 160.121667
## wave                                           -0.396077   0.073096 132.776290
## conditionReappraisal                            0.020852   0.076469 160.959733
## instructionregulate:wave                        0.075643   0.067232 137.669653
## instructionregulate:conditionReappraisal        0.002379   0.087624 159.651959
## wave:conditionReappraisal                      -0.295051   0.101263 131.482725
## instructionregulate:wave:conditionReappraisal   0.004838   0.092781 135.806163
##                                               t value             Pr(>|t|)    
## (Intercept)                                    59.292 < 0.0000000000000002 ***
## instructionregulate                           -15.581 < 0.0000000000000002 ***
## wave                                           -5.419          0.000000274 ***
## conditionReappraisal                            0.273               0.7854    
## instructionregulate:wave                        1.125               0.2625    
## instructionregulate:conditionReappraisal        0.027               0.9784    
## wave:conditionReappraisal                      -2.914               0.0042 ** 
## instructionregulate:wave:conditionReappraisal   0.052               0.9585    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) instrc wave   cndtnR instr: inst:R wv:cnR
## instrctnrgl -0.474                                          
## wave        -0.238  0.027                                   
## cndtnRpprsl -0.723  0.342  0.172                            
## instrctnrg:  0.074 -0.377 -0.601 -0.054                     
## instrctnr:R  0.343 -0.723 -0.020 -0.477  0.273              
## wv:cndtnRpp  0.172 -0.020 -0.722 -0.230  0.434  0.025       
## instrctn::R -0.054  0.273  0.436  0.071 -0.725 -0.368 -0.604

craving regulation

brain ~ instruction x wave

expression is stronger when regulating

the intervention increased expression when looking and decreased expression when regulating

tidytable

mod_instruction = lmer(dotProduct ~ instruction * wave * condition + (1 + instruction * wave | subjectID),
                  data = data_diss,
                  control = lmerControl(optimizer = "bobyqa"))
table_model(mod_instruction)
term b [95% CI] df t p
(Intercept) -2.02 [-2.76, -1.28] 161.88 -5.39 < .001
instruction (regulate) 8.01 [7.00, 9.02] 160.61 15.64 < .001
wave -0.26 [-1.06, 0.55] 144.66 -0.63 .530
condition (reappraisal) -0.67 [-1.69, 0.36] 161.70 -1.29 .200
instruction (regulate) x wave -0.32 [-1.35, 0.70] 138.50 -0.62 .540
instruction (regulate) x condition (reappraisal) 0.96 [-0.44, 2.37] 160.18 1.36 .180
wave x condition (reappraisal) 2.00 [0.89, 3.11] 143.90 3.56 < .001
instruction (regulate) x wave x condition (reappraisal) -0.81 [-2.23, 0.61] 137.80 -1.13 .260

simple slopes

modelbased::estimate_contrasts(mod_instruction, "wave", at = c("condition", "instruction"))

plot

look and regulate

ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(facet == "Control") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  facet_grid(~group) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(-3.5, 8)) +
  labs(x = "", y = "predicted signature expresison\n") + 
  dc_bw +
  theme(legend.position = c(.8, .2))

ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  facet_grid(~group) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(-3.5, 8)) +
  labs(x = "", y = "predicted signature expresison\n") + 
  dc_bw +
  theme(legend.position = c(.8, .2))

regulate only

p = ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(facet == "Control") %>%
  filter(group == "regulate") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(4, 8)) +
  labs(x = "", y = "predicted signature expresison\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction", "condition")) %>%
  data.frame() %>%
  mutate(x = recode(x, "0" = "pre", "1" = "post"),
         x = factor(x, levels = c("pre", "post"))) %>%
  filter(group == "regulate") %>%
  ggplot(aes(x, predicted, color = facet, fill = facet)) +
  geom_line(aes(group = facet), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), size = 1.5, linewidth = 1.5, position = position_dodge(.05)) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  scale_y_continuous(limits = c(4, 8)) +
  labs(x = "", y = "predicted signature expresison\n") + 
  dc_bw +
  theme(legend.position = c(.2, .2))

### model summary

summary(mod_instruction)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: dotProduct ~ instruction * wave * condition + (1 + instruction *  
##     wave | subjectID)
##    Data: data_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 82037.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -6.3323 -0.6079 -0.0014  0.6174  5.6596 
## 
## Random effects:
##  Groups    Name                     Variance Std.Dev. Corr             
##  subjectID (Intercept)               7.749   2.784                     
##            instructionregulate      14.302   3.782    -0.17            
##            wave                      4.438   2.107    -0.42  0.09      
##            instructionregulate:wave  4.637   2.153    -0.04 -0.27 -0.40
##  Residual                           62.219   7.888                     
## Number of obs: 11665, groups:  subjectID, 174
## 
## Fixed effects:
##                                               Estimate Std. Error       df
## (Intercept)                                    -2.0183     0.3747 161.8842
## instructionregulate                             8.0125     0.5123 160.6116
## wave                                           -0.2569     0.4058 144.6620
## conditionReappraisal                           -0.6686     0.5195 161.6993
## instructionregulate:wave                       -0.3216     0.5188 138.5014
## instructionregulate:conditionReappraisal        0.9641     0.7105 160.1824
## wave:conditionReappraisal                       1.9966     0.5610 143.8991
## instructionregulate:wave:conditionReappraisal  -0.8085     0.7171 137.7973
##                                               t value             Pr(>|t|)    
## (Intercept)                                    -5.386           0.00000025 ***
## instructionregulate                            15.639 < 0.0000000000000002 ***
## wave                                           -0.633             0.527732    
## conditionReappraisal                           -1.287             0.199864    
## instructionregulate:wave                       -0.620             0.536366    
## instructionregulate:conditionReappraisal        1.357             0.176730    
## wave:conditionReappraisal                       3.559             0.000505 ***
## instructionregulate:wave:conditionReappraisal  -1.128             0.261463    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) instrc wave   cndtnR instr: inst:R wv:cnR
## instrctnrgl -0.343                                          
## wave        -0.518  0.258                                   
## cndtnRpprsl -0.721  0.247  0.373                            
## instrctnrg:  0.218 -0.455 -0.586 -0.157                     
## instrctnr:R  0.247 -0.721 -0.186 -0.342  0.328              
## wv:cndtnRpp  0.374 -0.187 -0.723 -0.515  0.424  0.258       
## instrctn::R -0.158  0.329  0.424  0.217 -0.723 -0.452 -0.587

craving ~ brain x wave

between-person: average expression isn’t related to craving ratings

within-person: trials with higher than average expression are associated with lower craving ratings

tidy table

mod_craving = lmer(rating ~ dot_between * wave * condition + dot_within * wave * condition +
                     (1 + dot_within * wave | subjectID),
               data = data_diss,
               control = lmerControl(optimizer = "bobyqa"))
table_model(mod_craving)
term b [95% CI] df t p
(Intercept) 2.79 [2.69, 2.89] 158.16 56.03 < .001
between 0.06 [-0.03, 0.15] 161.73 1.22 .220
wave -0.37 [-0.49, -0.25] 139.28 -6.19 < .001
condition (reappraisal) 0.01 [-0.13, 0.14] 157.68 0.12 .910
within -0.25 [-0.30, -0.20] 157.84 -10.43 < .001
between x wave -0.07 [-0.20, 0.05] 148.73 -1.19 .230
between x condition (reappraisal) -0.06 [-0.18, 0.06] 158.05 -0.98 .330
wave x condition (reappraisal) -0.23 [-0.40, -0.06] 143.31 -2.73 .010
wave x within 0.01 [-0.05, 0.07] 141.93 0.32 .750
condition (reappraisal) x within -0.02 [-0.09, 0.04] 158.13 -0.62 .530
between x wave x condition (reappraisal) -0.03 [-0.20, 0.14] 148.42 -0.38 .710
wave x condition (reappraisal) x within 0.02 [-0.06, 0.10] 141.11 0.42 .680

plot

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_craving, terms = c("dot_between[vals]", "wave", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("dot_within[vals]", "wave", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(facet~type) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\npredicted signature expresison", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_between [-1, 0, 1]", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_within [-1, 0, 1]", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  mutate(x = as.factor(x)) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(facet~type) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted craving rating\n") + 
  dc_bw

model summary

summary(mod_craving)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave * condition + dot_within * wave *  
##     condition + (1 + dot_within * wave | subjectID)
##    Data: data_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 27928.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.2661 -0.6983 -0.0219  0.7017  3.1624 
## 
## Random effects:
##  Groups    Name            Variance Std.Dev. Corr             
##  subjectID (Intercept)     0.16898  0.4111                    
##            dot_within      0.02434  0.1560   -0.03            
##            wave            0.19157  0.4377   -0.35 -0.25      
##            dot_within:wave 0.01940  0.1393   -0.09 -0.09 -0.32
##  Residual                  0.67700  0.8228                    
## Number of obs: 11012, groups:  subjectID, 172
## 
## Fixed effects:
##                                         Estimate Std. Error         df t value
## (Intercept)                             2.787561   0.049753 158.155561  56.028
## dot_between                             0.055752   0.045638 161.730171   1.222
## wave                                   -0.372062   0.060079 139.275686  -6.193
## conditionReappraisal                    0.008137   0.068708 157.678971   0.118
## dot_within                             -0.249208   0.023891 157.844851 -10.431
## dot_between:wave                       -0.074557   0.062453 148.733625  -1.194
## dot_between:conditionReappraisal       -0.061143   0.062616 158.047865  -0.976
## wave:conditionReappraisal              -0.230859   0.084549 143.309508  -2.730
## wave:dot_within                         0.009609   0.029730 141.934213   0.323
## conditionReappraisal:dot_within        -0.020595   0.033063 158.126032  -0.623
## dot_between:wave:conditionReappraisal  -0.031761   0.084656 148.423203  -0.375
## wave:conditionReappraisal:dot_within    0.017293   0.041222 141.111874   0.420
##                                                   Pr(>|t|)    
## (Intercept)                           < 0.0000000000000002 ***
## dot_between                                        0.22363    
## wave                                         0.00000000624 ***
## conditionReappraisal                               0.90587    
## dot_within                            < 0.0000000000000002 ***
## dot_between:wave                                   0.23445    
## dot_between:conditionReappraisal                   0.33032    
## wave:conditionReappraisal                          0.00712 ** 
## wave:dot_within                                    0.74701    
## conditionReappraisal:dot_within                    0.53425    
## dot_between:wave:conditionReappraisal              0.70806    
## wave:conditionReappraisal:dot_within               0.67548    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw wave   cndtnR dt_wth dt_bt: dt_b:R wv:cnR wv:dt_
## dot_between  0.069                                                        
## wave        -0.407  0.021                                                 
## cndtnRpprsl -0.724 -0.050  0.294                                          
## dot_within  -0.020  0.007 -0.141  0.014                                   
## dot_btwn:wv -0.049 -0.462  0.089  0.035 -0.005                            
## dt_btwn:cnR -0.051 -0.729 -0.015  0.065 -0.005  0.336                     
## wv:cndtnRpp  0.289 -0.015 -0.711 -0.398  0.100 -0.064 -0.045              
## wav:dt_wthn -0.045 -0.013 -0.185  0.032 -0.430  0.005  0.010  0.132       
## cndtnRppr:_  0.014 -0.005  0.102 -0.022 -0.723  0.004  0.003 -0.141  0.310
## dt_btwn:w:R  0.036  0.341 -0.066 -0.029  0.004 -0.738 -0.476 -0.032 -0.003
## wv:cndtnR:_  0.032  0.009  0.134 -0.044  0.310 -0.003 -0.006 -0.184 -0.721
##             cndR:_ dt_::R
## dot_between              
## wave                     
## cndtnRpprsl              
## dot_within               
## dot_btwn:wv              
## dt_btwn:cnR              
## wv:cndtnRpp              
## wav:dt_wthn              
## cndtnRppr:_              
## dt_btwn:w:R -0.002       
## wv:cndtnR:_ -0.422  0.001

craving ~ brain x wave x condition

look trials

tidy table

mod_look = lmer(rating ~ dot_between*wave*condition + dot_within*wave*condition +
                            (1 + dot_within * wave | subjectID),
                      data = filter(data_diss, instruction == "look"),
                      control = lmerControl(optimizer = "bobyqa"))
table_model(mod_look)
term b [95% CI] df t p
(Intercept) 3.27 [3.16, 3.38] 159.25 58.52 < .001
between 0.07 [-0.03, 0.17] 154.24 1.34 .180
wave -0.41 [-0.56, -0.26] 131.82 -5.51 < .001
condition (reappraisal) 0.01 [-0.14, 0.16] 160.18 0.14 .890
within -0.03 [-0.08, 0.01] 133.40 -1.36 .180
between x wave -0.03 [-0.19, 0.13] 134.41 -0.38 .710
between x condition (reappraisal) -0.05 [-0.19, 0.08] 149.96 -0.75 .450
wave x condition (reappraisal) -0.25 [-0.46, -0.05] 135.11 -2.41 .020
wave x within -0.06 [-0.13, 0.02] 139.31 -1.54 .130
condition (reappraisal) x within -0.00 [-0.07, 0.06] 135.91 -0.10 .920
between x wave x condition (reappraisal) -0.10 [-0.31, 0.12] 135.43 -0.87 .380
wave x condition (reappraisal) x within 0.05 [-0.05, 0.15] 135.87 1.01 .320

plot

by wave
vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_look, terms = c("dot_between[vals]", "wave", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_look, terms = c("dot_within[vals]", "wave", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(type ~ facet) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\nsignature expresison", y = "predicted craving rating\n") + 
  dc_bw

by expression
ggeffects::ggpredict(mod_look, terms = c("wave", "dot_between [-1, 0, 1]", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_look, terms = c("wave", "dot_within [-1, 0, 1]", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  mutate(x = as.factor(x)) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(type ~ facet) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted craving rating\n") + 
  dc_bw

model summary

summary(mod_look)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave * condition + dot_within * wave *  
##     condition + (1 + dot_within * wave | subjectID)
##    Data: filter(data_diss, instruction == "look")
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 12607.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.5883 -0.6388  0.1014  0.7126  3.2035 
## 
## Random effects:
##  Groups    Name            Variance Std.Dev. Corr             
##  subjectID (Intercept)     0.202014 0.44946                   
##            dot_within      0.003441 0.05866  -0.06            
##            wave            0.269149 0.51880  -0.12  0.42      
##            dot_within:wave 0.017665 0.13291  -0.05 -0.50 -0.09
##  Residual                  0.501422 0.70811                   
## Number of obs: 5513, groups:  subjectID, 172
## 
## Fixed effects:
##                                         Estimate Std. Error         df t value
## (Intercept)                             3.267563   0.055838 159.247178  58.518
## dot_between                             0.067069   0.049977 154.238028   1.342
## wave                                   -0.409724   0.074369 131.817850  -5.509
## conditionReappraisal                    0.010952   0.077485 160.182303   0.141
## dot_within                             -0.031583   0.023273 133.399392  -1.357
## dot_between:wave                       -0.030488   0.080911 134.406575  -0.377
## dot_between:conditionReappraisal       -0.051371   0.068564 149.958852  -0.749
## wave:conditionReappraisal              -0.253971   0.105193 135.106349  -2.414
## wave:dot_within                        -0.057020   0.037078 139.306014  -1.538
## conditionReappraisal:dot_within        -0.003403   0.032579 135.905692  -0.104
## dot_between:wave:conditionReappraisal  -0.095250   0.109159 135.429262  -0.873
## wave:conditionReappraisal:dot_within    0.051785   0.051409 135.866956   1.007
##                                                   Pr(>|t|)    
## (Intercept)                           < 0.0000000000000002 ***
## dot_between                                         0.1816    
## wave                                           0.000000182 ***
## conditionReappraisal                                0.8878    
## dot_within                                          0.1770    
## dot_between:wave                                    0.7069    
## dot_between:conditionReappraisal                    0.4549    
## wave:conditionReappraisal                           0.0171 *  
## wave:dot_within                                     0.1264    
## conditionReappraisal:dot_within                     0.9170    
## dot_between:wave:conditionReappraisal               0.3844    
## wave:conditionReappraisal:dot_within                0.3156    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw wave   cndtnR dt_wth dt_bt: dt_b:R wv:cnR wv:dt_
## dot_between  0.066                                                        
## wave        -0.250  0.045                                                 
## cndtnRpprsl -0.721 -0.047  0.180                                          
## dot_within   0.150  0.027 -0.040 -0.108                                   
## dot_btwn:wv -0.046 -0.305  0.107  0.033 -0.034                            
## dt_btwn:cnR -0.048 -0.729 -0.033  0.067 -0.019  0.223                     
## wv:cndtnRpp  0.177 -0.032 -0.707 -0.248  0.028 -0.076 -0.042              
## wav:dt_wthn -0.123 -0.020  0.165  0.089 -0.632  0.037  0.014 -0.116       
## cndtnRppr:_ -0.107 -0.019  0.029  0.160 -0.714  0.025  0.026 -0.047  0.452
## dt_btwn:w:R  0.034  0.226 -0.080 -0.026  0.025 -0.741 -0.319 -0.043 -0.027
## wv:cndtnR:_  0.089  0.014 -0.119 -0.131  0.456 -0.027 -0.019  0.166 -0.721
##             cndR:_ dt_::R
## dot_between              
## wave                     
## cndtnRpprsl              
## dot_within               
## dot_btwn:wv              
## dt_btwn:cnR              
## wv:cndtnRpp              
## wav:dt_wthn              
## cndtnRppr:_              
## dt_btwn:w:R -0.025       
## wv:cndtnR:_ -0.639  0.027

regulate trials

tidy table

data_reversed = data_diss %>%
  mutate(condition = factor(condition, levels = c("Reappraisal", "Control")))

mod_regulate = lmer(rating ~ dot_between*wave*condition + dot_within*wave*condition +
                            (1 + dot_within + wave | subjectID),
                      data = filter(data_reversed, instruction == "regulate"),
                      control = lmerControl(optimizer = "bobyqa"))
table_model(mod_regulate)
term b [95% CI] df t p
(Intercept) 2.32 [2.20, 2.44] 162.18 38.61 < .001
between -0.03 [-0.13, 0.08] 163.73 -0.50 .620
wave -0.60 [-0.73, -0.48] 168.68 -9.42 < .001
condition (control) -0.04 [-0.21, 0.13] 163.20 -0.45 .650
within -0.02 [-0.06, 0.02] 361.70 -0.78 .440
between x wave -0.07 [-0.20, 0.05] 154.44 -1.14 .260
between x condition (control) 0.03 [-0.12, 0.19] 167.34 0.44 .660
wave x condition (control) 0.29 [0.11, 0.47] 162.27 3.15 < .001
wave x within 0.05 [-0.00, 0.11] 4002.80 1.84 .070
condition (control) x within 0.01 [-0.04, 0.07] 350.92 0.48 .630
between x wave x condition (control) 0.06 [-0.13, 0.24] 157.05 0.62 .540
wave x condition (control) x within -0.03 [-0.11, 0.05] 3826.31 -0.78 .430

simple slopes

modelbased::estimate_slopes(mod_regulate, "dot_between", at = c("condition", "wave=c(0,1)"))

plot

pre-post change
between-person
modelbased::estimate_contrasts(mod_regulate, "wave=c(1,0)", at = c("condition", "dot_between=seq(-3,3,.2)")) %>%
  data.frame() %>%
  ggplot(aes(x = dot_between, y = Difference)) +
  geom_ribbon(aes(fill = condition, ymin = CI_low, ymax = CI_high), alpha = 0.2) +
  geom_line(aes(colour = condition), size = 2) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  labs(x = "\naverage signature expression", y = "pre-post change in craving\n") +
  dc_bw

within-person
modelbased::estimate_contrasts(mod_regulate, "wave=c(1,0)", at = c("condition", "dot_within")) %>%
  data.frame() %>%
  ggplot(aes(x = dot_within, y = Difference)) +
  geom_ribbon(aes(fill = condition, ymin = CI_low, ymax = CI_high), alpha = 0.2) +
  geom_line(aes(colour = condition), size = 2) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  labs(x = "\nwithin-person signature expresison", y = "pre-post change in craving\n") +
  dc_bw

by wave
vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_regulate, terms = c("dot_between[vals]", "wave", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_regulate, terms = c("dot_within[vals]", "wave", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(type ~ facet) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\nsignature expresison", y = "predicted craving rating\n") + 
  dc_bw

by expression
ggeffects::ggpredict(mod_regulate, terms = c("wave", "dot_between [-1, 0, 1]", "condition")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_regulate, terms = c("wave", "dot_within [-1, 0, 1]", "condition")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  mutate(x = as.factor(x)) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(type ~ facet) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted craving rating\n") + 
  dc_bw

model summary

summary(mod_regulate)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave * condition + dot_within * wave *  
##     condition + (1 + dot_within + wave | subjectID)
##    Data: filter(data_reversed, instruction == "regulate")
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 11342.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.0936 -0.6846 -0.0424  0.5552  4.3338 
## 
## Random effects:
##  Groups    Name        Variance Std.Dev. Corr       
##  subjectID (Intercept) 0.273414 0.52289             
##            dot_within  0.005269 0.07259  -0.11      
##            wave        0.212454 0.46093  -0.55  0.04
##  Residual              0.399073 0.63172             
## Number of obs: 5499, groups:  subjectID, 172
## 
## Fixed effects:
##                                     Estimate Std. Error         df t value
## (Intercept)                          2.31841    0.06005  162.17513  38.605
## dot_between                         -0.02644    0.05308  163.72856  -0.498
## wave                                -0.60385    0.06411  168.67922  -9.420
## conditionControl                    -0.03963    0.08730  163.20169  -0.454
## dot_within                          -0.01617    0.02085  361.69916  -0.775
## dot_between:wave                    -0.07167    0.06311  154.44025  -1.136
## dot_between:conditionControl         0.03417    0.07834  167.34094   0.436
## wave:conditionControl                0.28784    0.09138  162.26733   3.150
## wave:dot_within                      0.05226    0.02841 4002.80379   1.840
## conditionControl:dot_within          0.01433    0.03003  350.91843   0.477
## dot_between:wave:conditionControl    0.05782    0.09364  157.05349   0.618
## wave:conditionControl:dot_within    -0.03149    0.04016 3826.31204  -0.784
##                                               Pr(>|t|)    
## (Intercept)                       < 0.0000000000000002 ***
## dot_between                                    0.61907    
## wave                              < 0.0000000000000002 ***
## conditionControl                               0.65042    
## dot_within                                     0.43869    
## dot_between:wave                               0.25790    
## dot_between:conditionControl                   0.66326    
## wave:conditionControl                          0.00195 ** 
## wave:dot_within                                0.06591 .  
## conditionControl:dot_within                    0.63352    
## dot_between:wave:conditionControl              0.53778    
## wave:conditionControl:dot_within               0.43303    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw wave   cndtnC dt_wth dt_bt: dt_b:C wv:cnC wv:dt_
## dot_between  0.062                                                        
## wave        -0.542 -0.129                                                 
## condtnCntrl -0.688 -0.042  0.373                                          
## dot_within  -0.181 -0.016  0.147  0.125                                   
## dot_btwn:wv -0.013 -0.585 -0.129  0.009  0.014                            
## dt_btwn:cnC -0.042 -0.678  0.087  0.077  0.011  0.396                     
## wv:cndtnCnt  0.380  0.090 -0.702 -0.556 -0.103  0.090 -0.068              
## wav:dt_wthn  0.106  0.014 -0.212 -0.073 -0.631 -0.020 -0.010  0.149       
## cndtnCntr:_  0.126  0.011 -0.102 -0.178 -0.694 -0.010 -0.017  0.146  0.438
## dt_btwn:w:C  0.009  0.394  0.087 -0.045 -0.010 -0.674 -0.576 -0.004  0.013
## wv:cndtnC:_ -0.075 -0.010  0.150  0.106  0.446  0.014  0.014 -0.207 -0.707
##             cndC:_ dt_::C
## dot_between              
## wave                     
## condtnCntrl              
## dot_within               
## dot_btwn:wv              
## dt_btwn:cnC              
## wv:cndtnCnt              
## wav:dt_wthn              
## cndtnCntr:_              
## dt_btwn:w:C  0.017       
## wv:cndtnC:_ -0.643 -0.026